home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / RANSTARS.ZIP / STARS.PAS
Pascal/Delphi Source File  |  1994-05-21  |  2KB  |  61 lines
  1. program _stars;
  2. { Done by Sven van Heel and Bas van Gaalen, Holland, PD }
  3. uses crt;
  4. const
  5.   f=6; nofstars=100; vidseg:word=$a000;
  6.   bitmask:array[0..1,0..4,0..4] of byte=(
  7.     ((0,0,1,0,0),(0,0,3,0,0),(1,3,6,3,1),(0,0,3,0,0),(0,0,1,0,0)),
  8.     ((0,0,6,0,0),(0,0,3,0,0),(6,3,1,3,6),(0,0,3,0,0),(0,0,6,0,0)));
  9. type starstruc=record
  10.   xp,yp:word; phase,col:byte; dur:shortint; active:boolean; end;
  11. var stars:array[1..nofstars] of starstruc;
  12.  
  13. procedure setpal(col,r,g,b : byte); assembler; asm
  14.   mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,r
  15.   out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;
  16.  
  17. procedure retrace; assembler; asm
  18.   mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  19.   @vert2: in al,dx; test al,8; jnz @vert2; end;
  20.  
  21. var i,x,y:word;
  22. begin
  23.   asm mov ax,13h; int 10h; end;
  24.   for i:=1 to 10 do begin
  25.     setpal(i,f*i,0,0); setpal(21-i,f*i,0,0); setpal(20+i,0,0,0);
  26.     setpal(30+i,0,f*i,0); setpal(51-i,0,f*i,0); setpal(50+i,0,0,0);
  27.     setpal(60+i,0,0,f*i); setpal(81-i,0,0,f*i); setpal(80+i,0,0,0);
  28.     setpal(90+i,f*i,f*i,0); setpal(111-i,f*i,f*i,0); setpal(110+i,0,0,0);
  29.     setpal(120+i,0,f*i,f*i); setpal(141-i,0,f*i,f*i); setpal(140+i,0,0,0);
  30.     setpal(150+i,f*i,f*i,f*i); setpal(171-i,f*i,f*i,f*i); setpal(170+i,0,0,0);
  31.   end;
  32.   randomize;
  33.   for i:=1 to nofstars do with stars[i] do begin
  34.     xp:=0; yp:=0; col:=0; phase:=0;
  35.     dur:=random(20);
  36.     active:=false;
  37.   end;
  38.   repeat
  39.     retrace; retrace;
  40.     {setpal(0,0,0,30);}
  41.     for i:=1 to nofstars do with stars[i] do begin
  42.       dec(dur);
  43.       if (not active) and (dur<0) then begin
  44.         active:=true; phase:=0; col:=30*random(6);
  45.         xp:=random(315); yp:=random(195);
  46.       end;
  47.     end;
  48.     for i:=1 to nofstars do with stars[i] do
  49.       if active then begin
  50.         for x:=0 to 4 do for y:=0 to 4 do
  51.           if bitmask[byte(phase>10),x,y]>0 then
  52.             mem[vidseg:(yp+y)*320+xp+x]:=bitmask[byte(phase>10),x,y]+col+phase;
  53.         inc(phase);
  54.         if phase=20 then begin active:=false; dur:=random(20); end;
  55.       end;
  56.     setpal(0,0,0,0);
  57.   until keypressed;
  58.   textmode(lastmode);
  59. end.
  60.  
  61.